perm filename FLOPS.SAI[11,ALS] blob
sn#063614 filedate 1973-09-21 generic text, type T, neo UTF8
00010 BEGIN "FLIPS"
00020 DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00030 INTEGER I,J,K,L,M,N,P,Q,R,POINTX,POINTY,STATE,DELTA,VAL,CHAN1,CHAN2,EOF;
00040 INTEGER ARRAY BUF,FLOPS[0:512];
00050 STRING FILEN,READ,READ1,FILEO,READ2;
00060 DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00070 ⊂ STATE=0 means on way up
00080 STATE=1 means on way down;
00090
00100 STDBRK(1);
00110 SETBREAK(14,"∃",NULL,"INS");
00120 SETBREAK(16,'56,NULL,"INA");
00130 FILEN←"FLTD.001[DAT,NJM]";
00140 OUTSTR("Type file name (CR for "&FILEN&".");
00150 IF (READ←INCHWL)≠"" THEN FILEN←READ ELSE READ←FILEN;
00160 READ1←""; FOR I←0 STEP 1 UNTIL 6 DO BEGIN
00170 READ2←READ[1 TO 1]; READ1←READ1&READ2; READ←READ[2 TO 6];
00180 IF READ2="." THEN DONE; END;
00190 FILEO←READ1&"FRI";
00200 POINTY←POINT(6,FLOPS[0],-1);
00210 OUTSTR("Specify DELTA (CR for 20) ");
00220 IF (READ←INCHWL)="" THEN DELTA←20 ELSE DELTA←CVD(READ);
00230 CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00240 LOOKUP(CHAN1,FILEN,0);
00250 J←K←L←STATE←VAL←R←0;
00260 READ1←FILEN;
00270 CHAN2←2; CLOSE(CHAN2); OPEN(CHAN2,"DSK",0,0,'10,0,0,0);
00280 READ2←SCAN(READ1,16,J)&"DOC";
00290 ENTER(CHAN2,READ2,0);
00300 OUT(CHAN2,CRLF&"Frication measure on file "&FILEN
00310 &" with DELTA set at "&CVS(DELTA)&CRLF&LF&TB);
00320 OUTSTR(CRLF&"Frication measure on file "&FILEN
00330 &" with DELTA set at "&CVS(DELTA)&CRLF&LF&TB);
00340 SETFORMAT(6,0);
00350 FOR I←0 STEP 1 UNTIL 9 DO OUTSTR(CVS(I)); OUTSTR(CRLF&LF);
00360 FOR I←0 STEP 1 UNTIL 9 DO OUT(CHAN2,CVS(I)); OUT(CHAN2,CRLF&LF);
00370 Q←0; P←1; OUTSTR(CVS(Q)&TB&" ");
00380 OUT(CHAN2,CVS(Q)&TB&" ");
00390 WHILE EOF=0 DO BEGIN
00400 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00410 ARRYIN(CHAN1,BUF[0],512);
00420 POINTX←POINT(12,BUF[0],-1);
00430 FOR I←0 STEP 1 UNTIL 11 DO BEGIN
00440 M←0;
00450 FOR J←0 STEP 1 UNTIL 127 DO BEGIN
00460 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00470 IF STATE=0 THEN BEGIN
00480 IF VAL<K-DELTA THEN BEGIN
00490 M←M+1; STATE←-1; END; END ELSE
00500 IF VAL>K+DELTA THEN BEGIN
00510 M←M+1; STATE←0; END;
00520 K←VAL;
00530 END;
00540 N←M;
00550 IF N>0 THEN OUTSTR(CVS(N)) ELSE OUTSTR(" ");
00560 IF N>0 THEN OUT(CHAN2,CVS(N)) ELSE OUT(CHAN2," ");
00570 ⊂ IF N>20 THEN N←N-20 ELSE N←0;
00580 IF N≤63 THEN IDPB(N,POINTY) ELSE IDPB(63,POINTY); R←R+1;
00590 IF (P MOD 10)=9 THEN BEGIN Q←Q+10;
00600 OUT(CHAN2,CRLF&CVS(Q)&TB);
00610 OUTSTR(CRLF&CVS(Q)&TB); P←0; END ELSE P←P+1;
00620 END;
00630 END;
00640
00650 CLOSE(CHAN1); CLOSE(CHAN2); OPEN(CHAN1,"DSK",'10,0,10,0,0,0);
00660 ENTER(CHAN1,FILEO,0); R←R%6+2;
00670 ARRYOUT(CHAN1,FLOPS[0],R); RELEASE(CHAN1);
00680 END "FLIPS";